-[ c library "pfunc.c" , header "pfunc.h" ]

+[private variables]
#include "interp.h"
+[end]

-[public] int run_pfunc_body
	(parser_t *parser)
{
	uterm_t *T;
	int ret;
	operand_t OP;
	variable_t *V;

again:
	T= utermlist_destroy(parser->body);
	if (!T) { ret= 1; goto done; }

	switch(T->kind) {
		case ut_number:
			if (!parser->expect_term)  
				reduce_stack(parser,0);
			OP.kind= operand_intconst;
			OP.d.intv= strtol(T->data,0,0);
			OP.code= 0;
			astack_push(parser->astack, OP);
			parser->expect_term= 0;
			goto again;
		case ut_strlit:
			callhistory_push(callhistory, T->linenumber);
			print_error_exit("string literals are not "
			  "implemented yet :)\n");
			break;
		case ut_macroarg: case ut_nmacroarg:
		case ut_smacroarg: case ut_wmacroarg:
			callhistory_push(callhistory, T->linenumber);
			print_error_exit("macro arguments are only "
				"valid in match statements\n");
			break;
		case ut_cu_bulk:
			run_curly_expr(parser,T->body,T->linenumber);
			goto again;
		case ut_ro_bulk: case ut_sq_bulk:
			callhistory_push(callhistory, T->linenumber);
			print_error_exit("parenthesis are not "
			  "implemented yet :)\n");
			break;
		 case ut_word:
			break;
	}

	if (!strcmp(T->data, "return"))   { ret= 1; goto done; }
	if (!strcmp(T->data,"fail"))  { ret= 0; goto done; }

	if ((V= find_var(parser,T->data))) {
		if (!parser->expect_term)  
			reduce_stack(parser,0);
		OP.kind= operand_varref;
		OP.d.varref= V;
		OP.code= 0;
		astack_push(parser->astack, OP);
		parser->expect_term= 0;
		goto again;
	}

	/* here, we call pfunc_call with codelist=0 because
	   the definitions in the global context will already
	   provide their own codelist */
	pfunc_call(T->data, T->linenumber, parser,
			global_context,0);
	goto again;

done:
	return ret;
}

-[builtin[C] match] {
	linenumber_t L= { "[builtin-match]", 1 };
	pflist_t *selfbindings;
	utermlist_t *pattern,*code;
	pflist_t *bindings;
	char buf[100];
	static int last;
	pfunc_t *CF;

	-[ selfbindings= parser->body ~ "{$PATTERN} {$CODE}" ]
	if (!selfbindings)
		return ;
	pattern= get_macro_arg(parser,selfbindings,"PATTERN");
	code= get_macro_arg(parser,selfbindings,"CODE");
	*success= 1;

	bindings= match_pattern(pattern,parser->parent->body);
	if (!bindings)
		return ;

	code= utermlist_deep_copy(code);
	sprintf(buf,"leave_match_scope%d", last++);
	utermlist_append(code, 
		uterm_simple(ut_word, strdup(buf), &L));
	utermlist_prepend_destructive(code, parser->body);
	
	CF= pfunc_new(pfunc_builtin,  strdup(buf), 
		&L, closure_new(leave_match_closure));
	closure_set(CF->d.builtin, "target_ctx",
			parser_top_context(parser));
	pflist_append(bindings, CF);

	costack_push(parser->costack, bindings);
}

-[private] void pfunc_call
	(char *name, linenumber_t *caller, parser_t *parser,
	pflist_t *gcontext,codelist_t *codelist)
{
	int done=0;
	pflist_t *C;
	int i;
	for(i=parser->costack->nelts-1;i>=0;i--) {
		C= parser->costack->elts[i];
		done=call_pfunc_in_context(C,name, caller,
				parser,codelist);
		if (done) break;
	}

	if (!done)
		done= call_pfunc_in_context(gcontext, name,
					caller,parser,codelist);
	if (!done) {
		dump_parsers(parser);
		callhistory_push(callhistory,caller);
		print_error_exit("can not find parser function '%s'\n",
				name);
	}
}

-[private] int call_pfunc_in_context
	(pflist_t *C, char *name, linenumber_t *caller,
	parser_t *parser,codelist_t *codelist)
{
	int done= 0;
	callhistory_push(callhistory,caller);
	-[ list>for K ∈ *C, begin ]
		if (!strcmp(K->name,name)) {
			switch(K->kind) {
			case pfunc_user:
				currentfunc_push(currentfunc,name);
				done= run_pfunc_body(
					parser_new(
					utermlist_deep_copy(K->d.user),
					parser));
				currentfunc_pop(currentfunc);
				break;
			case pfunc_builtin:
				currentfunc_push(currentfunc,name);
				done= run_builtin(K->d.builtin,
					parser,codelist);
				currentfunc_pop(currentfunc);
				break;
			}
			if (done)
				break;
		}
	-[ end ]
	callhistory_pop(callhistory);
	return done;
}


-[ closure leave_match , begin ]
	-[ arg target_ctx : pflist_t* ]
	-[ arg parser : parser_t*]
	-[ arg success : int*]
	-[ function is private ]
	-[ closure is private ]
-[ end ]
{
	while(parser_top_context(parser)!=target_ctx)
		costack_pop(parser->costack);
	*success= 1;
}


-[public] void pfunc_init() {
	closure_t *C;
	closure_t *C2;
	static linenumber_t L= {"[builtin]", 1};

	callhistory= callhistory_new();
	currentfunc= currentfunc_new();

	global_context= pflist_new();
	uglobal_context= pflist_new();

	*[ builtin functions ]
	*[ pfunc init ]
}


-[private] int run_builtin
	(closure_t *C, parser_t *parser,codelist_t *codelist)
{
	static linenumber_t L;
	int success;
	L.file= "[builtin]";
	L.line= 1;
	success= 0;
	callhistory_push(callhistory, &L);
	closure_set(C, "parser", parser);
	closure_set(C, "success", &success);
	closure_set(C,"codelist", codelist);
	closure_call(C);
	callhistory_pop(callhistory);
	return success;
}


-[ builtin[C] print ] {
	uterm_t *T;
	T= utermlist_destroy(parser->body);
	if (!T) return ;
	dump_term(T);
	*success= 1;
}

-[private] void register_builtin_func
	(char *name, closure_t *C,char* flags) 
{
	pfunc_t *CF;
	CF=  pfunc_new(pfunc_builtin,
			strdup(name),
			linenumber_new(mprintf("[builtin-%s]",name),1)
			,C); 
	if (strchr(flags,'C')) pflist_append(global_context,CF);
	if (strchr(flags,'U')) pflist_append(uglobal_context,CF);
}

-[ builtin[C] parser ] {
	pflist_t *match;
	utermlist_t *xname, *body;
	uterm_t *name;
	pfunc_t *CF;

	-[ match = parser->body ~ "function $W:NAME {$BODY}" ]
	if (!match) return ;

	xname= get_macro_arg(parser,match, "NAME");
	body= get_macro_arg(parser,match, "BODY");
	
	name= xname->head.next->data;

	CF= pfunc_new(pfunc_user, strdup(name->data),
			name->linenumber,utermlist_deep_copy(body));
	pflist_append(global_context, CF);
	pflist_append(uglobal_context, CF);
	*success= 1;
}

-[ builtin[CU] local ] {
	pflist_t *match;
	uterm_t *name;
	utermlist_t *type;
	variable_t *V;
	char *gname;
	static int last;
	closure_t *C;

	-[ match= parser->body ~  "$W:NAME : $TYPE;" ]
	if (!match) return ;

	name= get_single_word_binding(parser,match, "NAME");
	type= get_macro_arg(parser,match,"TYPE");

	gname= mprintf("_local_%s_%d",name->data, last++);

	V= variable_new(gname,  parse_type(parser,type));
	varlist_append(parser->vars, V);

	C= closure_new(pushvar_closure);
	closure_set(C,"var",V);
	pflist_append(parser_top_context(parser),
		pfunc_new(pfunc_builtin, strdup(name->data),
			name->linenumber, C));

	*success= 1;
}

-[closure pushvar, begin ]
	-[closure is private]
	-[function is private]
	-[arg parser : parser_t* ]
	-[arg var : variable_t * ]
	-[arg success : int* ]
-[end] {
	operand_t OP;
	*success= 1;
	if (!parser->expect_term)  
		reduce_stack(parser,0);
	OP.kind= operand_varref;
	OP.d.varref= var;
	OP.code= 0;
	astack_push(parser->astack, OP);
	parser->expect_term= 0;
}


-[private] int reduce_stack(parser_t *parser,int prec)
{
	static linenumber_t L = {"[builtin-reduce_stack]",1};
	operator_t OP;
	int ret= 0;
	while(1) {
		if (ostack_isempty(parser->ostack))
			return ret;
		OP= ostack_pop(parser->ostack);
		if ((OP.prec<prec) || (OP.prec==prec && OP.rassoc)) {
			ostack_push(parser->ostack,OP);
			return ret;
		}
		/* I converted the run_body to pfunc_call so
		    that we dont enter a new body context.
		    this way builtins dealing with parent`s stack,
		    symtable etc work correctly. */
		pfunc_call(OP.reduction,&L,  parser,global_context, 0);
		ret= 1;
	}

	return 0;
}

-[ builtin[CU] pushop ] {
	pflist_t *match;
	uterm_t *prec, *rassoc,*fname;
	operator_t OP;
	parser_t *pparser;

	-[ match=parser->body ~ "$N:PREC $N:RASSOC $W:FNAME" ]
	if (!match) return ;

	prec= get_single_word_binding(parser,match, "PREC");
	rassoc= get_single_word_binding(parser,match, "RASSOC");
	fname= get_single_word_binding(parser,match,"FNAME");

	pparser= parser->parent;

	if (pparser->expect_term) 
		print_error_exit("unexpected operator %s\n",
			fname->data);

	OP.prec= atoi(prec->data);
	OP.rassoc= atoi(rassoc->data);
	*success= 1;
	reduce_stack(pparser, OP.prec);
	OP.reduction= strdup(fname->data);
	ostack_push(pparser->ostack, OP);
	pparser->expect_term= 1;
}


-[private] utermlist_t *expand_macroarg
	(parser_t *parser,linenumber_t *caller, char *name)
{
	int nelts;
	operand_t A;
	utermlist_t *ret;
	utermlist_t *V;

#if 0
	simdi emin olamadim. burada bulacagimiz variable zaten
	sadece bu parserla birlikte gecerli ama biz bunu emit
	veya ppush fonksiyonuna gondericez, o zaman yukari
	ciktigi zaman cok anlamsiz olacak varref..
	if ((var=find_var(parser,name))) {
	}
#endif
	
	/* FIXME: think about how to handle the opstack also..
	   we must enforce the called function to reduce the stack */
	nelts= parser->astack->nelts;
	pfunc_call(name, caller, parser,global_context,0);

	if (parser->astack->nelts<=nelts) {
		callhistory_push(callhistory,caller);
		print_error_exit("stack underflow during expansion "
		    "of macro argument '%s'\n", name);
	}
		
	/* FIXME: think about how I should make linenumbers
	   here. this stuff is getting complicated */

	ret= utermlist_new();
	while(parser->astack->nelts!=nelts) {
		A= astack_pop(parser->astack);
		V= operand_to_utermlist(parser,&A,caller);
		utermlist_prepend_destructive(V,ret);
	}

	return ret;
}


-[ builtin[C] ulocal ] {
	pflist_t *match;
	uterm_t *name;
	utermlist_t *type;
	variable_t *V;
	static int last= 0;
	char buf[50];
	closure_t *C;

	-[ match= parser->body ~  "$W:NAME : $W:TYPE;" ]
	if (!match) return ;

	name= get_single_word_binding(parser,match, "NAME");
	type= get_macro_arg(parser,match,"TYPE");

	sprintf(buf,"_ulocal_%d",last++);
	V= variable_new( strdup(buf), parse_type(parser,type));
	varlist_append(parser->parent->vars, V);

	/* and now for the closure in this parser */
	C= closure_new(pushvar_closure);
	closure_set(C,"var",V);
	pflist_append(parser_top_context(parser),
		pfunc_new(pfunc_builtin, strdup(name->data),
			name->linenumber, C));

	*success= 1;
}

-[ simple 2-arg builtin operand, scope CU ]
{
	uterm_t *name;
	uterm_t *cname;
	parser_t *pparser;
	operand_t A;
	closure_t *C;
	utermlist_t *code;

	pparser= parser->parent;
	if (astack_isempty(pparser->astack))  {
		dump_parsers(parser);
		print_error_exit("stack underflow in 'operand'\n");
	}

	utermlist_toarray(a1,&name, 1);
	utermlist_toarray(a2,&cname, 1);

	A= astack_pop(pparser->astack);
	code= A.code;
	A.code= 0;
	C= closure_new(pushoperand_closure);
	closure_set(C, "value", A);
	pflist_append(parser_top_context(parser),
		pfunc_new(pfunc_builtin, strdup(name->data),
		name->linenumber, C));

	C= closure_new(pushcode_closure);
	if (!code) code= utermlist_new();
	else code= utermlist_deep_copy(code);
	closure_set(C,"value", code);
	pflist_append(parser_top_context(parser),
		pfunc_new(pfunc_builtin,strdup(cname->data),
		cname->linenumber,C));
}

/* TEMPORARY */
-[ simple 1-arg builtin expect_term, scope C] {
	uterm_t *A;
	utermlist_toarray(a1,&A,1);
	parser->parent->expect_term= atoi(A->data);
}

-[ builtin[CU] stackdump ] {
	*success= 1;
	dump_parsers(parser);
}



-[private] void run_curly_expr
	(parser_t *parser, utermlist_t *expr,linenumber_t *caller)
{
	char buf[20];
	closure_t *C;
	parser_t *copy;
	static int last;
	static linenumber_t lineno= { "[curly]", 1 };

	sprintf(buf,"_closeparen%d",last++);

	C= closure_new(close_curly_closure);
	-[ allocate object copy ]
	*copy= *parser;
	closure_set(C, "oparser", copy);
	closure_set(C, "selfname", strdup(buf));
	closure_set(C, "context", parser_top_context(parser));
	parser->astack= astack_new();
	parser->ostack= ostack_new();
	parser->expect_term= 1;

	expr= utermlist_deep_copy(expr);
	utermlist_append(expr, 
		uterm_simple(ut_word, strdup(buf), caller));
	utermlist_prepend_destructive(expr,parser->body);

	costack_push(parser->costack, pflist_new());
	pflist_append(parser_top_context(parser),
		pfunc_new(pfunc_builtin, strdup(buf), 
		&lineno, C));
}


-[ closure close_curly, begin ]
	-[ arg parser : parser_t* ]
	-[ arg success : int *]
	-[ arg oparser : parser_t* ]
	-[ arg selfname : char* ]
	-[ arg context : pflist_t* ]
	-[ function is private ]
	-[ closure is private ]
-[ end ]
{
	int i;
	astack_t *nastack;
	*success= 1;

	reduce_stack(parser,0);
	nastack= parser->astack;
	parser->astack= oparser->astack;
	parser->ostack= oparser->ostack;
	if (nastack->nelts)
		parser->expect_term=1;
	else
		parser->expect_term=0;
	for(i=0;i<nastack->nelts;i++) 
		astack_push(parser->astack, nastack->elts[i]);
	while(parser_top_context(parser)!=context)
		costack_pop(parser->costack);
}

-[private] utermlist_t *operand_to_utermlist
	(parser_t *parser,operand_t *A, linenumber_t *lineno)
{
	utermlist_t *ret;
	char buf[200];
	static int last_id;
	linenumber_t linenumber;
	closure_t *C;

	ret= utermlist_new();
	switch(A->kind) {
	case operand_varref:
		utermlist_append(ret,
			uterm_simple(ut_word,
				strdup(A->d.varref->name),
				lineno));
		break;
	case operand_intconst:
		sprintf(buf,"%d", A->d.intv);
		utermlist_append(ret,
			uterm_simple(ut_number,
				strdup(buf), lineno));
		break;
	case operand_utermlist:
		/* FIXME: maybe replace the line numbers in the
		   value with the one given to this function */
		utermlist_append_destructive(ret,
			utermlist_deep_copy(A->d.termlist));
		break;
	case operand_void:
		/* FIXME: what is this? */
		utermlist_append_destructive(ret,
			utermlist_deep_copy(A->code));
/*		print_error_exit("trying to use a void value");*/
		break;
	case operand_type:
		linenumber.file= "[builtin-type2utermlist]";
		linenumber.line= 1;
		sprintf(buf,"_pushtype%d",last_id++);
		C= closure_new(pushtype_closure);
		closure_set(C,"type",A->d.type);
		pflist_append(parser_top_context(parser),
			pfunc_new(pfunc_builtin, strdup(buf),
				&linenumber, C));
		utermlist_append(ret,
			uterm_simple(ut_word,strdup(buf),
				&linenumber));
		break;
	}
	return ret;
}

-[ closure pushtype, begin ]
	-[closure is private]
	-[function is private]
	-[arg parser : parser_t* ]
	-[arg type : type_t * ]
	-[arg success : int* ]
-[end] {
	operand_t OP;
	*success= 1;
	if (!parser->expect_term)  
		reduce_stack(parser,0);
	OP.kind= operand_type;
	OP.d.type= type;
	OP.code= 0;
	astack_push(parser->astack, OP);
	parser->expect_term= 0;
}


-[ builtin[C] utermlist ] {
	pflist_t *bindings;
	uterm_t *name;
	utermlist_t *body;
	pfunc_t *C;
	-[ bindings = parser->body ~ " $W:NAME {$BODY}" ]
	if (!bindings) return ;
	*success= 1;
	name= get_single_word_binding(parser,bindings,"NAME");
	body= get_macro_arg(parser,bindings, "BODY");
	C= pfunc_new(pfunc_builtin, strdup(name->data),
		name->linenumber,
		closure_new(utermlist_const_closure));
	closure_set(C->d.builtin, "value", utermlist_deep_copy(body));
	pflist_append(parser_top_context(parser),C);
}

-[ low level builtin _store:2, begin ]
	-[ simple compiler for store with 2 args ]
-[end]

-[ low level builtin _add:3, begin ]
	-[ simple compiler for add with 3 args ]
-[end]

-[ low level builtin _mul:3, begin ]
	-[ simple compiler for mul with 3 args ]
-[end]

-[ low level builtin _sub:3, begin ]
	-[ simple compiler for sub with 3 args ]
-[end]

-[low level builtin _pcall:2, begin]
	uterm_t *T;
	char *fname;
	int nfargs;
	int i;
	utermlist_toarray(args[0], &T, 1);
	fname= T->data;
	utermlist_toarray(args[1], &T, 1);
	nfargs= atoi(T->data);

	code_t *C;
	C= code_new( code_pcall, nfargs+1 );
	C->args[0].kind= carg_funcref;
	C->args[0].d.symbol= strdup(fname);
	for(i=0;i<nfargs;i++) {
		utermlist_t *A;
		get_n_args(parser, 1, &A);
		utermlist_to_carg(parser, A, &C->args[i+1]);
	}
	codelist_append(codelist, C);
-[end]

-[low level builtin _fcall:2, begin]
	uterm_t *T;
	char *fname;
	int nfargs;
	int i;
	utermlist_toarray(args[0], &T, 1);
	fname= T->data;
	utermlist_toarray(args[1], &T, 1);
	nfargs= atoi(T->data);

	code_t *C;
	C= code_new( code_fcall, nfargs+2 );
	C->args[0].kind= carg_funcref;
	C->args[0].d.symbol= strdup(fname);
	for(i=0;i<nfargs+1;i++) {
		utermlist_t *A;
		get_n_args(parser, 1, &A);
		utermlist_to_carg(parser, A, &C->args[i+1]);
	}
	codelist_append(codelist, C);
-[end]

/* TEMPORARY */
-[ simple 1-arg builtin printvar, scope [C] ] 
{
	carg_t A;
	int *Z;
	utermlist_to_carg(parser,a1,&A);
	printf("VAR %s [", A.d.varref->name);
	dump_type(A.d.varref->type);
	printf("]=");
	/* FIXME: check for the type first, THEN dump it as an int */
	Z= A.d.varref->value;
	if (!Z)
		printf("unassigned\n");
	else
		printf("%d\n", Z[0]);
}

-[closure pushoperand, begin]
	-[ function is private ]
	-[ closure is private]
	-[ arg success : int* ]
	-[ arg parser : parser_t* ]
	-[ arg value : operand_t ]
-[end] {
	*success= 1;
	astack_push(parser->astack, value);
}

-[ closure pushcode, begin ]
	-[ function is private ]
	-[ closure is private]
	-[ arg success : int* ]
	-[ arg parser : parser_t* ]
	-[ arg value : utermlist_t* ]
-[ end] {
	operand_t A;
	A.kind= operand_void;
	A.code= utermlist_deep_copy(value);
	astack_push(parser->astack,A);
	*success= 1;
}

-[ simple 1-arg builtin ppush, scope CU ]
{
	operand_t A;
	utermlist_t *Z;

	if (astack_isempty(parser->astack)) 
		print_error_exit("stack underflow\n");

	A= astack_pop(parser->astack);

	Z= utermlist_deep_copy(a1);
	-[ utermlist>deep-for K ∈ Z, begin ]
		if (K->kind==ut_macroarg) {
			utermlist_t *value;
			struct utermlist_t_NODE *U,*Knext;
			value= expand_macroarg
					(parser, K->linenumber,
					K->data);
			-[ nlist>for each U in (&value->head) , begin ]
				-[ nlist>remove U ]
				-[ nlist>insert U before K_node ]
			-[ end ]
			Knext= K_node->next;
			-[ nlist>remove K_node ]
			K_node->next= Knext;
		}
	-[ end ]
	A.code= Z;
	astack_push(parser->parent->astack, A);
}

-[ builtin[CU] _semicolon ] {
	operand_t A;
	*success= 1;
	reduce_stack(parser,0);
	if (astack_isempty(parser->astack)) 
		return ;
	A= astack_pop(parser->astack);
	parser->expect_term= 1;
	if (A.code && !utermlist_isempty(A.code))
		utermlist_prepend_destructive(
			utermlist_deep_copy(A.code), parser->body);
}

-[public] variable_t* find_var(parser_t *P,char *name) {
	-[list>for V ∈ *P->vars,begin]
		if (!strcmp(V->name,name))
			return V;
	-[end]
	return 0;
}

-[ simple 2-arg builtin expecting_term, scope C ] {
	utermlist_t *body;
	if (parser->parent->expect_term) 
		body= a1;
	else
		body= a2;
	body= utermlist_deep_copy(body);
	utermlist_prepend_destructive(body, parser->body);
}

-[simple 1-arg builtin emit, scope C] {
	utermlist_t *Z;
	Z= utermlist_deep_copy(a1);
	-[ utermlist>deep-for K ∈ Z, begin ]
		if (K->kind==ut_macroarg) {
			utermlist_t *value;
			struct utermlist_t_NODE *U,*Knext;
			value= expand_macroarg
					(parser, K->linenumber,
					K->data);
			-[ nlist>for each U in (&value->head) , begin ]
				-[ nlist>remove U ]
				-[ nlist>insert U before K_node ]
			-[ end ]
			Knext= K_node->next;
			-[ nlist>remove K_node ]
			K_node->next= Knext;
		}
	-[ end ]
	utermlist_prepend_destructive(Z, parser->parent->body);
}

-[builtin[CU] int] {
	type_t *T;
	operand_t OP;

	*success= 1;
	if (!parser->expect_term)  
		reduce_stack(parser,0);

	-[ allocate object T ]
	T->kind= type_basic;
	T->basic.basic= basic_int;
	OP.kind= operand_type;
	OP.d.type= T;
	OP.code= 0;
	astack_push(parser->astack,OP);
	parser->expect_term= 0;
}

-[public] type_t *parse_type(parser_t *parser,utermlist_t *expr)
{
	type_t *ret;
	parser_t OLD;
	int K;
	operand_t A;

	linenumber_t linenumber;
	linenumber.file= "[builtin-parse_type]";
	linenumber.line= 1;

	OLD.astack= parser->astack;
	parser->astack= astack_new();

	OLD.ostack= parser->ostack;
	parser->ostack= ostack_new();

	OLD.expect_term= parser->expect_term;
	parser->expect_term= 1;

	OLD.body= parser->body;
	parser->body= utermlist_deep_copy(expr);

	K= run_pfunc_body(parser);
	if (!K)
		print_error_exit("type parser failed\n");
	reduce_stack(parser,0);
	if (astack_isempty(parser->astack))
		print_error_exit("type parser failed : "
			"expression yields no result\n");
	A= astack_pop(parser->astack);
	switch(A.kind) {
	case operand_type:
		ret= A.d.type;
		break;
	case operand_varref:
		ret= A.d.varref->type;
		break;
	default:
		print_error_exit("type parser failed : "
			"resulting expression is not a type\n");
	}

	parser->body= OLD.body;
	parser->expect_term= OLD.expect_term;
	parser->ostack= OLD.ostack;
	parser->astack= OLD.astack;

	return ret;
}

-[ builtin[CU] nop ] { *success= 1; }

-[ builtin[CU] _addressof ] {
	operand_t A;

	if (astack_isempty(parser->astack))  {
		dump_parsers(parser);
		print_error_exit("stack underflow in 'addressof'\n");
	}

	A= astack_pop(parser->astack);

	if (A.kind==operand_type) {
		type_t *T;
		*success= 1;
		-[ allocate object T ]
		T->kind= type_pointer;
		T->pointer.base= A.d.type;
		A.d.type= T;
		astack_push(parser->astack,A);
		return ;
	}
	astack_push(parser->astack,A);
}
